Otherware/Otherware_1_SB_Development.iso/mac/hypercar/xfcn/newfilen.sit/NewFileName XFCN/card_2549.txt

Text File | 1987-12-01 | 11.2 KB | 351 lines

-- card: 2549 from stack: in
-- bmap block id: 3801
-- flags: 0000
-- background id: 2716
-- name:


-- part 1 (field)
-- low flags: 01
-- high flags: 0007
-- rect: left=3 top=23 right=337 bottom=438
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 22
-- text size: 9
-- style flags: 0
-- line height: 12
-- part name:


-- part 2 (button)
-- low flags: 00
-- high flags: 0000
-- rect: left=452 top=37 right=90 bottom=503
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name:
----- HyperTalk script -----
on mouseUp
  get NewFileName("Name for source file:","NewFileName.p")
  if it is not empty then
    put it into theFile
    open file theFile
    write card field 1 to file theFile
    close file theFile
  end if
end mouseUp



-- part 5 (button)
-- low flags: 00
-- high flags: 2000
-- rect: left=466 top=286 right=313 bottom=495
-- title width / last selected line: 0
-- icon id / first selected line: 26425 / 26425
-- text alignment: 1
-- font id: 3
-- text size: 9
-- style flags: 0
-- line height: 12
-- part name: Look at this script
----- HyperTalk script -----
on mouseUp
  visual iris open to black
  visual dissolve fast
  go to next card
end mouseUp



-- part contents for card part 1
----- text -----
{
          NewFileName
            ***********
            A HyperCard "XFCN" (External Function) Resource
            Version 1.0

Written By: Steve Maller
             Apple Computer Training Support
             Copyright © 1987 Apple Computer
             AppleLink: MALLER1
            Monday, November 30, 1987

Language:    MPW Pascal

To build:  pascal NewFileName.p
           link -m ENTRYPOINT -rt XFCN=914 -sn Main=NewFileName Γêé
              -t STAK -c WILD Γêé
              NewFileName.p.o Γêé
              hd:dev:mpw:libraries:Interface.o Γêé
              hd:dev:mpw:PLibraries:Paslib.o Γêé
              -o "NewFileName XFCN"

Usage:      NewFileName("prompt", "defaultName")
                                    -- "prompt" & "defaultName" are optional

Examples:    NewFileName("Enter a name:", "My file")
                    -- prompts the user with a default name of "My file"
            NewFileName("Enter a name:")
                    -- prompts the user with no default name

Result:      The full pathname of the file the user chose to create.
            THIS XFCN DOES NOT CREATE THE FILE; HYPERCARD MUST!
            For example, if you selected the file "Address Stack" which is
            in the folder "My Stacks" in the folder "HyperCard" on the
            disk "HD" the result is:
                  HD:HyperCard:My Stacks:Address Stack

Warning:    A word of caution: the MacΓÇÖs file system can NOT accept
            pathnames longer than 255 characters. Be careful...

Script
Example:    on mouseUp
              put NewFileName("Enter a new name:") into theFile
              if theFile is not empty then
                open file theFile
                write container to file theFile
                close file theFile
              end if
            end mouseUp

Why?        You must access files in HyperCard by their full pathname.
            Unfortunately, HyperCard offers you no clear way of finding
            out what that full name is. If files are on a hard disk, it
            can be a real pain to remember the entire pathname. This
            function simplifies that task for both the stackware developer
            and the end user.

Thanks to:  The HyperCard Team - my heros!

}

{$S NewFileName }

UNIT Snoopy_Vs_TheRedBaron; { obviously this name is irrelevant }

{ =----------------------INTERFACE----------------------= }

  INTERFACE

    USES
      {$LOAD PasSymDump}
      MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf, HyperXCmd;

    PROCEDURE EntryPoint(paramPtr: XCmdPtr);

{ =----------------------IMPLEMENTATION----------------------= }

  IMPLEMENTATION

    {$R-}
    { no Pascal range checking }

    TYPE
      Str31 = String[31];          { for the glue file ΓÇ£XCmdGlue.incΓÇ¥ }

    PROCEDURE NewFileName(paramPtr: XCmdPtr);
      FORWARD;

        { =----------------------EntryPoint----------------------= }

    PROCEDURE EntryPoint(paramPtr: XCmdPtr);

      BEGIN
        NewFileName(paramPtr);
      END;

        { =----------------------NewFileName----------------------= }

    PROCEDURE NewFileName(paramPtr: XCmdPtr);

      VAR
        myWDPB: WDPBPtr; { some variants of the same animal }
        myCPB: CInfoPBPtr;
        myPB: HParmBlkPtr;
        fullPathName: Str255;
        userPrompt: Str255;  { the "prompt" parameter }
        defaultName: Str255;  { the "defaultName" parameter }
        numTypes: Integer;
        reply: SFReply;
        typeList: SFTypeList;

        {$I XCmdGlue.inc }

        { =----------------------CenterWindow----------------------= }

      PROCEDURE CenterWindow(w: WindowPtr);

      { a general-purpose routine that will center the window whoΓÇÖs
        WindowPtr is passed in w. Here it is used to center the still-
        invisible SFGetFile dialog box. WeΓÇÖll just steal the coordinates
        of the upper-left corner of the dialog to pass to SFGetFile... }

        VAR
          hWindSize: Integer;
          vWindSize: Integer;
          hSize: Integer;
          vSize: Integer;

        BEGIN
          WITH w^.portBits.bounds DO    { find out how big the SCREEN is }
            BEGIN
              hSize := right - left;    { NOTE: this centers the window }
              vSize := bottom - top;    { within screenBits.bounds ONLY. }
            END;                        { It will NOT recognize multiple }
                                        { monitors on a Mac II... }
          WITH w^.portRect DO
            BEGIN
              hWindSize := right - left;  { get the size of the window }
              vWindSize := bottom - top;
            END;

          { now move the window to the appropriate place on the screen }

          MoveWindow(w, ((hSize - hWindSize) DIV 2),
                        ((vSize - vWindSize + 20) DIV 2), FALSE);
        END;

      { =----------------------TheyChoseAFile----------------------= }

      FUNCTION TheyChoseAFile: Boolean;

        VAR
          pt: Point;
          wPtr: WindowPtr;
          savePort: WindowPtr;

        BEGIN
          TheyChoseAFile := FALSE;

          GetPort(savePort);              { save the current grafport }

          { load in the SFGetFile DLOG resource for perousal }

          wPtr := GetNewDialog(putDlgID, NIL, POINTER( - 1));

          SetPort(wPtr);                  { set port to it for LocalToGlobal }
          CenterWindow(wPtr);              { center (still invisible) window }
          pt := wPtr^.portRect.topLeft;    { is 0,0 - but no assumptions! }
          LocalToGlobal(pt);              { convert this into global coords }

          SFPutFile(pt, userPrompt, defaultName, NIL, reply);

          SetPort(savePort);              { restore the grafport }

          IF reply.good THEN { if they didnΓÇÖt choose Cancel }
            BEGIN
              TheyChoseAFile := TRUE;
              fullPathName := reply.fName; { start the ball rolling }
            END;
        END;

      { =----------------------BuildThePathName----------------------= }

      PROCEDURE BuildThePathName;

        VAR
          name: Str255;
          err: Integer;

        BEGIN
          name := '';                           { start with an empty name }
          myPB^.ioNamePtr := @name;             { we want the Volume name }
          myPB^.ioCompletion := POINTER(0);
          myPB^.ioVRefNum := reply.vRefNum;     { returned from SFGetFile }
          myPB^.ioVolIndex := 0;                 { use the vRefNum and name }
          err := PBHGetVInfo(myPB, FALSE);       { fill in the Volume info }
          IF err <> noErr THEN
            Exit(NewFileName);

{ Now we need the Working Directory (WD) information because weΓÇÖre going
 to step backwards from the file through all of the the folders until
 we reach the root directory }

          myWDPB^.ioVRefNum := reply.vRefNum;   { this got set to 0 above }
          myWDPB^.ioWDProcID := 0;               { use the vRefNum }
          myWDPB^.ioWDIndex := 0;               { we want ALL directories }
          err := PBGetWDInfo(myWDPB, FALSE);     { do it }
          IF err <> noErr THEN
            Exit(NewFileName);

          myCPB^.ioFDirIndex := - 1;             { use the ioDirID field only }
          myCPB^.ioDrDirID := myWDPB^.ioWDDirID; { info returned above }
          err := PBGetCatInfo(myCPB, FALSE);     { do it }
          IF err <> noErr THEN
            Exit(NewFileName);

{ Here starts the real work - start to climb the tree by continually
 looking in the ioDrParId field for the next directory above until we
 fail... }

          myCPB^.ioDrDirID := myCPB^.ioDrParId;     { the first folder}
          fullPathName := Concat(myCPB^.ioNamePtr^, ':', reply.fName);
          REPEAT
            myCPB^.ioDrDirID := myCPB^.ioDrParId;
            err := PBGetCatInfo(myCPB, FALSE);       { the next level }

{ Be careful of an error returned here - it means the user chose a file
 on the desktop level of this volume. If this is the case, just stop
 here and return "VolumeName:NewFileName", otherwise loop until failure }
            IF err = noErr THEN
              fullPathName := Concat(myCPB^.ioNamePtr^, ':', fullPathName);

          UNTIL err <> noErr;

        END; { PROCEDURE BuildThePathName }

      { =---------------------- * NewFileName * ----------------------= }

      BEGIN { PROCEDURE NewFileName }

{ First we allocate some memory in the heap for the parameter block. This
 could in theory work on the stack, but in reality it makes no difference
 as weΓÇÖre entirely modal (ugh) here... }

        fullPathName := '';              { -EMPTY- if we fail! }
        userPrompt := '';                { the "prompt" parameter }
        defaultName := '';              { the "defaultName" parameter }

        myCPB := CInfoPBPtr(NewPtr(SizeOf(HParamBlockRec)));
        IF ord4(myCPB) <= 0 THEN
          Exit(NewFileName);             { Rats! Bill didnΓÇÖt leave enough room }
        myWDPB := WDPBPtr(myCPB);       { icky Pascal type coercions... }
        myPB := HParmBlkPtr(myCPB);

        WITH paramPtr^ DO
          BEGIN
            IF paramCount >= 1 THEN
              ZeroToPas(params[1]^, userPrompt);
            IF paramCount = 2 THEN
              ZeroToPas(params[2]^, defaultName);

            IF TheyChoseAFile THEN
              BuildThePathName;

{ PasToZero is very interesting - it is a HyperTalk command
 that you can actually call from OUTSIDE of HyperCard.
 You need it because HyperCard uses C format strings with
 no length byte; they are terminated by a null byte. They are
 actually HANDLES to C format strings. Nice work, Dan! }

            returnValue := PasToZero(fullPathName);

          END; { WITH paramPtr^ DO }

        DisposPtr(POINTER(myCPB));       { Thou Shalt Clean Up Thy Heap! }

        numTypes := StringWidth('NewFileName version 1.0 • ©1987 Steve Maller');

      END; { PROCEDURE NewFileName }

END.